home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / ddsgen.arc / DDSRPF03.RPG < prev    next >
Encoding:
Text File  |  1991-12-04  |  35.2 KB  |  441 lines
  1.      F********************************************************************      
  2.      F*                                                                  *      
  3.      F*  PGMID -        DDS01RPF03                                       *      
  4.      F*                                                                  *      
  5.      F*  FUNCTION -     GENERATE FIELD LEVEL PHYSICAL FILE DDS           *      
  6.      F*                                                                  *      
  7.      F*  AUTHOR -       TERRENCE W. MOYER                                *      
  8.      F*                 55 KEPPEL AVE.                                   *      
  9.      F*                 WEST LAWN, PA. 19609                             *      
  10.      F*                                                                  *      
  11.      F*  DATE -         NOV. 3, 1986                                     *      
  12.      F*                                                                  *      
  13.      F*  INDICATORS -   10  GENERAL PURPOSE, REUSABLE.                   *      
  14.      F*                 U1  DO NOT GENERATE FIELD REFERENCING IF U1 ON.  *      
  15.      F*                                                                  *      
  16.      F*  NOTES -                                                         *      
  17.      F*                 SUPPORTED KEYWORDS                               *      
  18.      F*                 REFFLD, TEXT, EDTCDE/EDTWRD, REFSHIFT, COLHDG    *      
  19.      F*                 DFT, ALIAS.                                      *      
  20.      F*                 FLTPCN(*SINGLE) (SUPPORTED BY DEFAULT)           *
  21.      F*                                                                  *      
  22.      F*                 UNSUPPORTED KEYWORDS                             *      
  23.      F*                 CMP, COMP, RANGE, FLTPCN(*DOUBLE).               *      
  24.      F*                                                                  *      
  25.      F********************************************************************      
  26.      FQADSPFFDIF  E                    DISK                           UC        
  27.      FSRCFIL  O   F      92            DISK                      A    UC        
  28.      E                    WRK        68  1               WORK ARRAY             
  29.      E                    WRK1       36  1               DDS FUNCT. FIELD       
  30.      E                    WRK2       20  1               COLHDG WORK            
  31.      I*  LDA WITH INPUT FILE AND SOURCE FILE INFORMATION                        
  32.      I           UDS                                                            
  33.      I                                        1  10 LINFL                       
  34.      I                                       11  20 LINLB                       
  35.      I                                       21  26 LINDT                       
  36.      I                                       27  32 LINTM                       
  37.      I                                       33  33 LINTYP                      
  38.      I                                       51 100 LINTXT                      
  39.      I                                      101 110 LSRCFL                      
  40.      I                                      111 120 LSRCLB
  41.      I                                      121 130 LSRCMB                      
  42.      I                                      201 2062LSRCSQ                      
  43.      I                                      207 2120LSRCDT                      
  44.      I* SOURCE SEQUENCE AND SOURCE DATE DS - WRITTEN TO DDS SRCFILE.            
  45.      I            DS                                                            
  46.      I                                        1   62SRCSEQ                      
  47.      I                                        7  120SRCDAT                      
  48.      I* DDS SPECIFICATION - TO WRITE ACTUAL SPEC RECORDS TO DDS SRCFILE.        
  49.      IDSPEC       DS                                                            
  50.      I                                        1   5 DBLNK1                      
  51.      I                                        6   6 DSPECA                      
  52.      I                                        7  16 DBLNK2                      
  53.      I                                       17  17 DNMTYP                      
  54.      I                                       18  18 DBLNK3                      
  55.      I                                       19  28 DNAME                       
  56.      I                                       29  29 DREF                        
  57.      I                                       30  34 DLEN                        
  58.      I                                       35  35 DDTYP                       
  59.      I                                       36  37 DDEC                        
  60.      I                                       38  44 DBLNK4
  61.      I                                       45  80 DFUNC                       
  62.      I                                        1  80 DSPEC1                      
  63.      I                                        7  80 DSPEC2                      
  64.      C*------------------------------------------------------------------*      
  65.      C*                         MAINLINE                                 *      
  66.      C*------------------------------------------------------------------*      
  67.      C* INITIALIZATION AND SETUP.                                               
  68.      C*                                                                         
  69.      C                     Z-ADDLSRCSQ    SRCSEQ           RETRIEVE SRCSEQ      
  70.      C                     Z-ADDLSRCDT    SRCDAT           AND SRCDAT.          
  71.      C                     MOVE 'A'       DSPECA           INIT. SPEC. DS.      
  72.      C*                                                                         
  73.      C                     OPEN SRCFIL                     OPEN FILES.          
  74.      C                     OPEN QADSPFFD                                        
  75.      C                     READ QADSPFFD                 10 GET RECORD.         
  76.      C*                                                                         
  77.      C*------------------------------------------------------------------*      
  78.      C*                    WRITE FIELD LEVEL KEYWORDS.                          
  79.      C*------------------------------------------------------------------*      
  80.      C*  FOR EACH FIELD DO:
  81.      C           *IN10     DOWEQ'0'                                             
  82.      C*                                                                         
  83.      C*  CREATE FIELD NAME RECORD.                                              
  84.      C                     MOVE WHFLDE    DNAME            MOVE FIELD NAME      
  85.      C           WHRFIL    IFNE *BLANK                     IS THIS A REF        
  86.      C           *INU1     ANDNE'1'                        KEYWORD FIELD.       
  87.      C                     MOVE 'R'       DREF             IF SO AND NU1        
  88.      C                     EXSR @BLDRF                     BUILD KEYWORD.       
  89.      C                     ELSE                            ELSE,                
  90.      C           WHFLDD    IFGT *ZERO                      IF FLD NUMERIC       
  91.      C                     MOVE WHFLDD    DLEN             DECIMAL DIGITS.      
  92.      C                     MOVE WHFLDP    DDEC             DECIMAL PLACES.      
  93.      C                     ELSE                            ELSE IF ALPHA-       
  94.      C                     MOVE WHFLDB    DLEN             ALPH FLD LENGTH      
  95.      C                     END                             END LENGTH.          
  96.      C                     MOVEADLEN      WRK1                                  
  97.      C                     Z-ADD+1        X                                     
  98.      C           WRK1,X    DOWEQ'0'                                             
  99.      C           WRK1,X    OREQ ' '                        ZERO SUPPRESS        
  100.      C           X         ANDLE+5                         LENGTH FIELD.
  101.      C                     MOVE ' '       WRK1,X                                
  102.      C                     ADD  +1        X                                     
  103.      C                     END                                                  
  104.      C                     MOVEAWRK1,1    DLEN                                  
  105.     C                     MOVEADDEC      WRK1                                  
  106.      C           WRK1,1    IFEQ '0'                                             
  107.      C                     MOVE ' '       WRK1,1           ZERO SUPPRESS        
  108.      C                     END                             DECIMAL POS.         
  109.      C                     MOVEAWRK1      DDEC                                  
  110.      C                     MOVE WHFLDT    DDTYP            MOVE FLD TYPE.       
  111.      C                     END                             IF REF. END.         
  112.      C*  WRITE OTHER SUPPORTED KEYWORDS.                                        
  113.      C           WHCHD1    IFNE *BLANK                                          
  114.      C           WHCHD2    ORNE *BLANK                                          
  115.      C           WHCHD3    ORNE *BLANK                                          
  116.     C                     MOVE '1'       COLHD   1                             
  117.     C                     EXSR @COLHD                     COLHDG KEYWORD.      
  118.      C                     ELSE                                                 
  119.      C                     MOVE '0'       COLHD                                 
  120.     C                     END
  121.      C           WHFTXT    IFNE *BLANK                                          
  122.      C                     EXSR @TEXT                      TEXT FIELD-LVL.      
  123.      C                     END                                                  
  124.      C                     MOVELWHECDE    BYTE    1                             
  125.      C           BYTE      IFNE *BLANK                     EDTCDE KEYWORD       
  126.      C                     MOVE *BLANK    WRK1                                  
  127.      C                     MOVEA'EDTCDE(' WRK1                                  
  128.      C                     MOVEAWHECDE    WRK1,8                                
  129.      C                     MOVEA')'       WRK1,9                                
  130.      C                     MOVEAWRK1      DFUNC                                 
  131.      C                     MOVE DSPEC1    LINE                                  
  132.      C                     EXSR @SRCLN                                          
  133.      C                     MOVE *BLANK    DSPEC2                                
  134.      C                     ELSE                                                 
  135.      C           WHEWRD    IFNE *BLANK                     EDTWRD KEYWORD       
  136.      C                     MOVE *BLANK    WRK1                                  
  137.      C                     MOVEA'EDTWRD(' WRK1                                  
  138.      C                     MOVEAWHEWRD    WRK1,8                                
  139.      C                     Z-ADD+36       X                                     
  140.      C           WRK1,X    DOWEQ' '
  141.      C                     SUB  +1        X                                     
  142.      C                     END                                                  
  143.      C                     ADD  +1        X                                     
  144.      C                     MOVEA')'       WRK1,X                                
  145.      C                     MOVEAWRK1      DFUNC                                 
  146.      C                     MOVE DSPEC1    LINE                                  
  147.      C                     EXSR @SRCLN                                          
  148.      C                     MOVE *BLANK    DSPEC2                                
  149.      C                     END                                                  
  150.      C                     END                                                  
  151.      C           WHSHFT    IFNE *BLANK                     REFSHIFT             
  152.      C                     MOVE *BLANK    WRK1             KEYWORD.             
  153.      C                     MOVEA'REFSHIFT'WRK1                                  
  154.      C                     MOVE '('       WRK1,9                                
  155.      C                     Z-ADD+10       X                                     
  156.      C                     MOVEAWHSHFT    WRK1,X                                
  157.      C                     ADD  +1        X                                     
  158.      C                     MOVEA')'       WRK1,X                                
  159.      C                     MOVEAWRK1      DFUNC                                 
  160.      C                     MOVE DSPEC1    LINE
  161.      C                     EXSR @SRCLN                                          
  162.      C                     MOVE *BLANK    DSPEC2                                
  163.      C                     END                                                  
  164.      C           WHDFT     IFNE *BLANK                     DFT                  
  165.      C                     MOVE *BLANK    WRK1             KEYWORD.             
  166.      C                     MOVEA'DFT('    WRK1                                  
  167.      C                     MOVEAWHDFT     WRK1,5                                
  168.      C                     Z-ADD+36       X                                     
  169.      C           WRK1,X    DOWEQ' '                                             
  170.      C                     SUB  +1        X                                     
  171.      C                     END                                                  
  172.      C                     ADD  +1        X                                     
  173.      C           WHDFTL    IFEQ -1                         CHECK DFT VALUE      
  174.      C           WRK1,5    ANDEQ''''                       FOR TRUNCATION.      
  175.      C                     MOVEA''')'     WRK1,X           IF TRUNCATED         
  176.      C                     ELSE                            AND VALUE IS         
  177.      C                     MOVEA')'       WRK1,X           QUOTED, MOVE AN      
  178.      C                     END                             END QUOTE.           
  179.      C                     MOVEAWRK1      DFUNC                                 
  180.      C                     MOVE DSPEC1    LINE
  181.      C                     EXSR @SRCLN                                          
  182.      C                     MOVE *BLANK    DSPEC2                                
  183.      C                     END                                                  
  184.      C           WHALIS    IFNE *BLANK                     ALIAS                
  185.      C                     MOVE *BLANK    WRK1             KEYWORD.             
  186.      C                     MOVEA'ALIAS('  WRK1                                  
  187.      C                     MOVEAWHALIS    WRK1,7                                
  188.      C                     Z-ADD+36       X                                     
  189.      C           WRK1,X    DOWEQ' '                                             
  190.      C                     SUB  +1        X                                     
  191.      C                     END                                                  
  192.      C                     ADD  +1        X                                     
  193.      C                     MOVEA')'       WRK1,X                                
  194.      C                     MOVEAWRK1      DFUNC                                 
  195.      C                     MOVE DSPEC1    LINE                                  
  196.      C                     EXSR @SRCLN                                          
  197.      C                     MOVE *BLANK    DSPEC2                                
  198.      C                     END                                                  
  199.      C*                                                                         
  200.      C                     READ QADSPFFD                 10 GET RECORD.
  201.      C                     END                             END READ LOOP.       
  202.      C*                                                                         
  203.      C* CLOSE FILES, PASS DATA, AND END PROGRAM.                                
  204.      C*                                                                         
  205.      C                     CLOSEQADSPFFD                                        
  206.      C                     CLOSESRCFIL                                          
  207.      C*                                                                         
  208.      C                     Z-ADDSRCSEQ    LSRCSQ           PASS SRCSEQ          
  209.      C                     Z-ADDSRCDAT    LSRCDT           AND SRCDAT           
  210.      C                     SETON                       LR                       
  211.      C*                                                                         
  212.      C*------------------------------------------------------------------*      
  213.      C*                 @BLDRF  -  BUILD THE REFFLD KEYWORD                     
  214.      C*------------------------------------------------------------------*      
  215.      C*                                                                         
  216.      C           @BLDRF    BEGSR                                                
  217.      C*                                                                         
  218.      C                     MOVE *BLANK    WRK1                                  
  219.      C                     MOVEA'REFFLD(' WRK1             MOVE KEYWORD TO      
  220.      C                     Z-ADD+8        Y       40       ARRAY
  221.      C*                                                                         
  222.      C                     MOVE *BLANK    WRK                                   
  223.      C                     MOVEAWHRFLD    WRK              BUILD REFERENCE      
  224.      C                     Z-ADD+1        X       40       FIELDS.              
  225.      C           WRK,X     DOWNE' '                        FIND END OF          
  226.      C                     ADD  +1        X                REFFLD NAME.         
  227.      C                     END                                                  
  228.      C                     MOVE '.'       WRK,X                                 
  229.      C                     ADD  +1        X                                     
  230.      C                     MOVEAWHRFMT    WRK,X                                 
  231.      C           WRK,X     DOWNE' '                        FIND END OF          
  232.      C                     ADD  +1        X                FORMAT NAME.         
  233.      C                     END                                                  
  234.      C                     ADD  +1        X                                     
  235.      C                     MOVEAWHRFIL    WRK,X                                 
  236.      C           WRK,X     DOWNE' '                        FIND END OF          
  237.      C                     ADD  +1        X                FILE NAME.           
  238.      C                     END                                                  
  239.      C                     MOVE '.'       WRK,X                                 
  240.      C                     ADD  +1        X
  241.      C                     MOVEAWHRLIB    WRK,X                                 
  242.      C           WRK,X     DOWNE' '                        FIND END OF          
  243.      C                     ADD  +1        X                LIBRARY NAME.        
  244.      C                     END                                                  
  245.      C                     SUB  +1        X                RESET LENGTH.        
  246.      C                     Z-ADDX         REFLEN  40       SAVE LENGTH.         
  247.      C*  MOVE REFERENCE TO FUNCTION WORK ARRAY.                                 
  248.      C                     Z-ADD+1        X                FOR X = 1            
  249.      C           X         DOWLEREFLEN                     TO REFLEN DO         
  250.      C                     MOVE WRK,X     WRK1,Y           MOVE A CHAR.         
  251.      C                     ADD  +1        X                ADD TO INDEX.        
  252.      C                     ADD  +1        Y                                     
  253.      C           Y         IFEQ +36                        CHECK FOR            
  254.      C           X         ANDLEREFLEN                                          
  255.      C                     MOVE '-'       WRK1,Y           CONTINUATION         
  256.      C                     MOVEAWRK1      DFUNC            LINES                
  257.      C                     MOVE DSPEC1    LINE   80                             
  258.      C                     EXSR @SRCLN                     WRITE THE            
  259.      C                     MOVE *BLANK    WRK1             CONTINUATION         
  260.      C                     Z-ADD+1        Y                LINE.
  261.      C                     MOVE *BLANK    DSPEC2                                
  262.      C                     END                             END CONTIUATION      
  263.      C                     END                             END DOWLE REFL.      
  264.      C                     MOVEA')'       WRK1,Y           MOVE IN END-         
  265.      C                     MOVEAWRK1      DFUNC            PARENTHESIS.         
  266.      C                     MOVE DSPEC1    LINE             WRITE REF.           
  267.      C                     EXSR @SRCLN                                          
  268.      C                     MOVE *BLANK    DSPEC2                                
  269.      C*                                                                         
  270.      C                     ENDSR                                                
  271.      C*------------------------------------------------------------------*      
  272.      C/SPACE 3                                                                  
  273.      C*------------------------------------------------------------------*      
  274.      C*                 @COLHD  -  BUILD THE COLHDG KEYWORD                     
  275.      C*------------------------------------------------------------------*      
  276.      C*                                                                         
  277.      C           @COLHD    BEGSR                                                
  278.      C*                                                                         
  279.      C                     MOVE *BLANK    WRK1                                  
  280.      C                     MOVEA'COLHDG(' WRK1             MOVE KEYWORD TO
  281.      C                     Z-ADD+8        Y       40       ARRAY                
  282.      C*                                                                         
  283.      C*  COLHDG LOOP SETUP.                                                     
  284.      C           WHCHD2    IFEQ *BLANK                     DETERMINE            
  285.      C           WHCHD3    ANDEQ*BLANK                     HOW MANY TIMES       
  286.      C                     Z-ADD+1        LPCNT   40       THROUGH THE          
  287.      C                     ELSE                            COLHDG LOOP.         
  288.      C           WHCHD3    IFEQ *BLANK                     MAXIMUM IS 3.        
  289.      C                     Z-ADD+2        LPCNT                                 
  290.      C                     ELSE                                                 
  291.      C                     Z-ADD+3        LPCNT                                 
  292.      C                     END                                                  
  293.      C                     END                                                  
  294.      C*                                                                         
  295.      C                     MOVE *BLANK    WRK              CLEAR WORK ARRY      
  296.      C                     Z-ADD+1        X                                     
  297.      C*                                                                         
  298.      C*  MAIN LOOP TO CREATE COLHDGS - EXECUTED THREE TIMES AT MOST.            
  299.      C           1         DO   LPCNT     W       40       FOR EACH COLHDG      
  300.      C           W         IFEQ +1                         DO:
  301.      C                     MOVELWHCHD1    FIELD  20                             
  302.      C                     END                             DETERMINE WHICH      
  303.      C           W         IFEQ +2                         HEADING TO USE       
  304.      C                     MOVELWHCHD2    FIELD            IN THE LOOP.         
  305.      C                     END                             PUT HEADING IN       
  306.      C           W         IFEQ +3                         FIELD.               
  307.      C                     MOVELWHCHD3    FIELD                                 
  308.      C                     END                                                  
  309.      C*                                                                         
  310.      C           FIELD     IFEQ *BLANK                     IF COLHDG BLANK      
  311.      C                     MOVEA''' '''   WRK,X            PUT ' ' IN           
  312.      C                     ADD  +4        X                WRK ARRAY.           
  313.      C                     ELSE                            ELSE                 
  314.      C                     MOVEAFIELD     WRK2             GET LENGTH OF        
  315.      C                     EXSR @COLLN                     HEADING AND          
  316.      C                     MOVE ''''      WRK,X            MOVE STARTING        
  317.      C                     ADD  +1        X                QUOTE & HEADING      
  318.      C                     Z-ADD+1        Z                TO WRK.              
  319.      C           Z         DOWLECOLLEN                                          
  320.      C                     MOVE WRK2,Z    WRK,X            MOVE HEAD ONE
  321.      C                     ADD  +1        X                CHAR. AT A TIME      
  322.      C                     ADD  +1        Z                                     
  323.      C                     END                             END DOWLE.           
  324.      C                     MOVE ''''      WRK,X            PLACE END QUOTE      
  325.      C                     ADD  +2        X                AND A SPACE.         
  326.      C                     END                             END IFEQ.            
  327.      C                     END                             END DO 3 TIMES.      
  328.      C*                                                                         
  329.      C                     Z-ADD+68       X                FIND TOTAL           
  330.      C           WRK,X     DOWEQ' '                        LENGTH OF            
  331.      C                     SUB  +1        X                COLHDG DATA.         
  332.      C                     END                                                  
  333.      C                     Z-ADDX         COLLEN           SAVE LENGTH.         
  334.      C*                                                                         
  335.      C*  MOVE HEADINGS TO FUNCTION WORK ARRAY.                                  
  336.      C                     Z-ADD+1        X                FOR X = 1            
  337.      C           X         DOWLECOLLEN                     TO COLLEN DO         
  338.      C                     MOVE WRK,X     WRK1,Y           MOVE A CHAR.         
  339.      C                     ADD  +1        X                ADD TO INDEX.        
  340.      C                     ADD  +1        Y
  341.      C           Y         IFEQ +36                        CHECK FOR            
  342.      C                     MOVE '-'       WRK1,Y           CONTINUATION         
  343.      C                     MOVEAWRK1      DFUNC            LINES                
  344.      C                     MOVE DSPEC1    LINE   80                             
  345.      C                     EXSR @SRCLN                     WRITE THE            
  346.      C                     MOVE *BLANK    WRK1             CONTINUATION         
  347.      C                     Z-ADD+1        Y                LINE.                
  348.      C                     MOVE *BLANK    DSPEC2                                
  349.      C                     END                             END CONTIUATION      
  350.      C                     END                             END DOWLE REFL.      
  351.      C                     MOVEA')'       WRK1,Y           MOVE IN CLOSING      
  352.      C                     MOVEAWRK1      DFUNC            PARENTHESIS AND      
  353.      C                     MOVE DSPEC1    LINE   80        WRITE THE            
  354.      C                     EXSR @SRCLN                     KEYWORD.             
  355.      C                     MOVE *BLANK    DSPEC2                                
  356.      C*                                                                         
  357.      C                     ENDSR                                                
  358.      C*------------------------------------------------------------------*      
  359.      C/SPACE 3                                                                  
  360.      C*------------------------------------------------------------------*
  361.      C*            @COLLN - GET THE LENGTH OF STRING IN WRK2.                   
  362.      C*------------------------------------------------------------------*      
  363.      C*                                                                         
  364.      C           @COLLN    BEGSR                                                
  365.      C*                                                                         
  366.      C                     Z-ADD+20       Z       40                            
  367.      C           WRK2,Z    DOWEQ' '                                             
  368.      C           Z         ANDGE+1                                              
  369.      C                     SUB  +1        Z                                     
  370.      C                     END                                                  
  371.      C                     Z-ADDZ         COLLEN  40                            
  372.      C*                                                                         
  373.      C                     ENDSR                                                
  374.      C*------------------------------------------------------------------*      
  375.      C/SPACE 3                                                                  
  376.      C*------------------------------------------------------------------*      
  377.      C*                 @TEXT - BUILD FIELD LEVEL TEXT                          
  378.      C*------------------------------------------------------------------*      
  379.      C*                                                                         
  380.      C           @TEXT     BEGSR
  381.      C*                                                    IF SUPPRESS          
  382.     C           *INU2     IFEQ '1'                        TEXT OPTION,         
  383.      C           COLHD     ANDEQ'1'                        AND COLHD'S          
  384.      C                     GOTO ENDTXT                     EXIST, THEN          
  385.      C                     END                             EXIT.                
  386.      C*                                                                         
  387.      C           WHFTXT    IFNE *BLANK                     BEGIN TEXT.          
  388.      C                     MOVE *BLANK    WRK                                   
  389.      C                     MOVE *BLANK    WRK1                                  
  390.      C                     MOVEA'TEXT(''' WRK1             INIT FUNC ARRAY      
  391.      C                     Z-ADD+7        Y       40       AND INDEX.           
  392.      C                     MOVEAWHFTXT    WRK              FIND LENGTH OF       
  393.      C                     Z-ADD+50       X                FILE TEXT.           
  394.      C           WRK,X     DOWEQ' '                                             
  395.      C                     SUB  +1        X                                     
  396.      C                     END                                                  
  397.      C                     Z-ADDX         TXTLEN  40       SAVE LENGTH.         
  398.      C*  MOVE TEXT TO FUNCTION WORK ARRAY.                                      
  399.      C                     Z-ADD+1        X                FOR X = 1            
  400.      C           X         DOWLETXTLEN                     TO  TXTLEN DO
  401.      C                     MOVE WRK,X     WRK1,Y           MOVE A CHAR.         
  402.      C                     ADD  +1        X                ADD TO INDEX.        
  403.      C                     ADD  +1        Y                                     
  404.      C           Y         IFEQ +36                        CHECK FOR            
  405.      C                     MOVE '-'       WRK1,Y           CONTINUATION         
  406.      C                     MOVEAWRK1      DFUNC            LINES                
  407.      C                     MOVE DSPEC1    LINE                                  
  408.      C                     EXSR @SRCLN                     WRITE THE            
  409.      C                     MOVE *BLANK    WRK1             CONTINUATION         
  410.      C                     Z-ADD+1        Y                LINE.                
  411.      C                     MOVE *BLANK    DSPEC2                                
  412.      C                     END                             END CONTIUATION      
  413.      C                     END                             END DOWLE TXTL.      
  414.      C                     MOVEA''')'     WRK1,Y           MOVE IN END-         
  415.      C                     MOVEAWRK1      DFUNC            QUOTE AND PAREN.     
  416.      C                     MOVE DSPEC1    LINE             WRITE TEXT.          
  417.      C                     EXSR @SRCLN                                          
  418.      C                     MOVE *BLANK    DSPEC2                                
  419.      C                     END                             END TEXT IF.         
  420.      C*
  421.      C           ENDTXT    ENDSR                                                
  422.      C*------------------------------------------------------------------*      
  423.      C/SPACE 3                                                                  
  424.      C*------------------------------------------------------------------*      
  425.      C*       ADD TO SOURCE SEQUENCE NUMBER AND WRITE AN OUTPUT LINE            
  426.      C*------------------------------------------------------------------*      
  427.      C*                                                                         
  428.      C           @SRCLN    BEGSR                                                
  429.      C*                                                                         
  430.      C                     ADD  +1        SRCSEQ                                
  431.      C                     EXCPTSRCLIN                                          
  432.      C*                                                                         
  433.      C                     ENDSR                                                
  434.      C*------------------------------------------------------------------*      
  435.      C/SPACE 3                                                                  
  436.      OSRCFIL  EADD             SRCLIN                                           
  437.      O                         SRCSEQ     6                                     
  438.      O                         SRCDAT    12                                     
  439.      O                         LINE      92
  440. 
  441.